perm filename F.MAC[X,ALS] blob
sn#037696 filedate 1973-10-11 generic text, type T, neo UTF8
00100
00200 TITLE FRXFM
00300 ; FAST FOURIER TRANSFORM 842 FOR N=2**N2POW
00400 ; THIS PROGRAM REPLACES THE VECTOR Z=X+IY BY ITS FINITE
00500 ; DISCRETE, COMPLEX FOURIER TRANSFORM. IT PERFORMS AS MANY BASE
00600 ; 8 ITERATIONS AS POSSIBLE AND THEN FINISHES WITH A BASE 4
00700 ; ITERATION OR A BASE 2 ITERATION IF NEEDED.
00800 ;
00900 ; THE SUBROUTINE IS CALLED AS SUBROUTINE FRXFM(N2POW,X,Y)
01000 ; THE INTEGER N2POW (WHERE N=2**N2POW), THE N REAL LOCATION
01100 ; ARRAY X, AND THE N REAL LOCATION ARRAY Y MUST BE SUPPLIED
01200 ; TO THE SUBROUTINE.
01300 ;
01400 ; THE EXECUTION TIME OF THE ORIGINAL FORTRAN VERSION OF THIS
01500 ; PROGRAM FOR N=1024 WAS APPROXIMATELY 0.6 SECONDS ON THE
01600 ; G.E. 635 COMPUTER. THE TIME FOR THE FOLLOWING MACRO VERSION
01700 ; IS 0.45 SECONDS ON THE DIGITAL EQUIPMENT CORPORATION PDP-10,
01800 ; WHERE TIME=42*(N*N2POW) MICROSECONDS.
01900 ;
02000 ; THIS WORK MADE USE OF ARPA GRANT AF30(602)-4277 AT THE
02100 ; UNIVERSITY OF UTAH (APRIL, 1970).
02200 ;
02300 ; COMMENTS BY D. OESTREICHER (APRIL, 1971)
02400 ; SLIGHT MODIFICATIONS ALSO
02500 ;
02600 ; THE VARIABLE NAMES IN THE COMMENTS REFER TO VARIABLE
02700 ; NAMES USED IN THE ABOVE MENTIONED FORTRAN PROGRAM.
02800 ;
02900 ENTRY FRXFM
03000 EXTERN FLOAT,COS,SIN
03100 FRXFM: 0
03200 MOVEM 17,ACSAV+17
03300 HRRZI 17,ACSAV
03400 BLT 17,ACSAV+16
03500 MOVE 0,@0(16)
03600 HRRM 0,N2POWA ;INITAILIZE IMMED. CONST. N2POW
03700 HRRM 0,N2POWB ;INITAILIZE IMMED. CONST. N2POW
03800 HRRM 0,N2POWC ;INITAILIZE IMMED. CONST. N2POW
03900 HRRM 0,N2POWD ;INITAILIZE IMMED. CONST. N2POW
04000 MOVE 0,1(16)
04100 HRRM 0,LOP$1 ;INITIALIZE IMMED. CONST. PTR TO X ARRAY
04200 HRRM 0,LOP$3 ;INITIALIZE IMMED. CONST. PTR TO X ARRAY
04300 HRRM 0,LOP$5 ;INITIALIZE IMMED. CONST. PTR TO X ARRAY
04400 SUBI 0,1
04500 MOVEM 0,X
04600 HRRM 0,R2CR0A
04700 HRRM 0,R2CR0B
04800 HRRM 0,R4CR0A
04900 HRRM 0,R4CR0B
05000 HRRM 0,R8CR0A
05100 HRRM 0,R8CR0B
00100
00200 ADDI 0,1
00300 HRRM 0,R2CR1A
00400 HRRM 0,R2CR1B
00500 HRRM 0,R4CR1A
00600 HRRM 0,R4CR1B
00700 ADDI 0,1
00800 HRRM 0,R4CR2A
00900 HRRM 0,R4CR2B
01000 HRRM 0,R4CR2C
01100 ADDI 0,1
01200 HRRM 0,R4CR3A
01300 HRRM 0,R4CR3B
01400 HRRM 0,R4CR3C
01500 MOVE 0,2(16)
01600 HRRM 0,LOP$2 ;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
01700 HRRM 0,LOP$4 ;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
01800 HRRM 0,LOP$6 ;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
01900 SUBI 0,1
02000 MOVEM 0,Y
02100 HRRM 0,R2CI0A
02200 HRRM 0,R2CI0B
02300 HRRM 0,R4CI0A
02400 HRRM 0,R4CI0B
02500 HRRM 0,R8CI0A
02600 HRRM 0,R8CI0B
02700 ADDI 0,1
02800 HRRM 0,R2CI1A
02900 HRRM 0,R2CI1B
03000 HRRM 0,R4CI1A
03100 HRRM 0,R4CI1B
03200 ADDI 0,1
03300 HRRM 0,R4CI2A
03400 HRRM 0,R4CI2B
03500 HRRM 0,R4CI2C
03600 ADDI 0,1
03700 HRRM 0,R4CI3A
03800 HRRM 0,R4CI3B
03900 HRRM 0,R4CI3C
04000 MOVEI 0,1
04100 N2POWA: LSH 0,.-. ;MODIFIED TO CONST. N2POW
04200 HRRM 0,NTHPOA ;INITIALIZE IMMED. CONST. NTHPO
04300 HRRM 0,NTHPOB ;INITIALIZE IMMED. CONST. NTHPO
04400 HRRM 0,NTHPOC ;INITIALIZE IMMED. CONST. NTHPO
04500 HRRM 0,NTHPOD ;INITIALIZE IMMED. CONST. NTHPO
04600 N2POWB: MOVEI 1,.-. ;MODIFIED TO CONST. N2POW
04700 IDIVI 1,3
04800 HRRM 1,N8POWA ;INITIALIZE IMMED. CONST. N8POW
04900 HRRM 1,N8POWB ;INITIALIZE IMMED. CONST. N8POW
05000 JUMPE 1,P3
05100 MOVEI 15,1
05200 ;***ALL CODE ABOVE IS EXECUTED ONLY ONCE AS INITIALIZATION***
00100
00200 LOOP1: MOVEM 15,IPASS
00300 IMUL 15,NEG.3
00400 N2POWC: ADDI 15,.-. ;MODIFIED TO CONST. N2POW
00500 MOVEI 3,1
00600 LSH 3,@15
00700 MOVEM 3,NXTLT
00800 SUBI 3,1
00900 HRRM 3,NXTLTA ;INIT. IMMED. VAR. NXTLT-1
01000 ADDI 3,1
01100 ASH 3,3
01200 MOVEM 3,LENGT
01300 HRRM 3,LENGTA ;INIT. IMMED. VAR. LENGT
01400 JRST R8TX
01500 CONT8: MOVE 15,IPASS
01600 N8POWA: CAIGE 15,.-. ;INITED TO IMMED. CONST. N8POW
01700 AOJA 15,LOOP1
01800 P3:
01900 N8POWB: MOVNI 4,.-. ;INITED TO IMMED. CONST. N8POW
02000 IMULI 4,3
02100 N2POWD: ADDI 4,.-. ;MODIFIED TO CONST. N2POW
02200 SUBI 4,1
02300 JUMPL 4,P5
02400 JUMPG 4,P7
02500 JRST R2TX
02600 P7: JRST R4TX
02700 JRST FINISH
02800 R2TX: MOVEI 15,1
02900 R2TXL:
03000 R2CR0A: MOVE 1,.-.(15) ; 1=CR0
03100 R2CR1A: MOVE 2,.-.(15) ; 2=CR1
03200 R2CR0B: FADRM 2,.-.(15) ; CR0=CR1+CR0
03300 R2CR1B: FSBRM 1,.-.(15) ; CR1=CR0-CR1
03400 R2CI0A: MOVE 1,.-.(15) ; 1=CI0
03500 R2CI1A: MOVE 2,.-.(15) ; 2=CI2
03600 R2CI0B: FADRM 2,.-.(15) ; CI0=CI1+CI0
03700 R2CI1B: FSBRM 1,.-.(15) ; CI1=CI0-CI1
03800 ADDI 15,2
03900 NTHPOA: CAIG 15,.-. ;INITED TO IMMED. CONST. NTHPO
04000 JRST R2TXL
04100 JRST P5
04200
04300 R4TX: MOVEI 15,1
04400 R4TXL:
04500 R4CR0A: MOVE 1,.-.(15) ; 1=CR0
04600 R4CR2A: FADR 1,.-.(15) ; 1=R1=CR0+CR2
04700 R4CR1A: MOVE 2,.-.(15) ; 2=CR1
04800 R4CR3A: FADR 2,.-.(15) ; 2=R3=CR1+CR3
04900 R4CI0A: MOVE 3,.-.(15) ; 3=CI0
05000 R4CI2A: FADR 3,.-.(15) ; 3=FI1=CI0+CI2
05100 R4CI1A: MOVE 4,.-.(15) ; 4=CI1
00100
00200 R4CI3A: FADR 4,.-.(15) ; 4=FI3=CI1+CI3
00300 MOVE 5,1 ; 5=R1
00400 FADR 5,2 ;** 5=CR0=R1+R3
00500 FSBR 1,2 ;** 1=CR1=R1-R3
00600 MOVE 2,3 ; 2=FI1
00700 FADR 2,4 ;** 2=CI0=FI1+FI3
00800 FSBR 3,4 ;** 3=CI1=FI1-FI3
00900 R4CR0B: EXCH 5,.-.(15) ;* 5=CR0
01000 R4CR1B: EXCH 1,.-.(15) ;* 1=CR1
01100 R4CI0B: EXCH 2,.-.(15) ;* 2=CI0
01200 R4CI1B: EXCH 3,.-.(15) ;* 3=CI1
01300 R4CR2B: FSBR 5,.-.(15) ; 5=R2=CR0-CR2
01400 R4CR3B: FSBR 1,.-.(15) ; 1=R4=CR1-CR3
01500 R4CI2B: FSBRB 2,.-.(15) ; 2=CI2=FI2=CI0-CI2
01600 R4CI3B: FSBR 3,.-.(15) ; 3=FI4=CI1-CI3
01700 MOVE 4,5 ; 4=R2
01800 FSBR 4,3 ;** 4=CR2=R2-FI4
01900 FADR 5,3 ;** 5=CR3=R2+FI4
02000 R4CI2C: FADRM 1,.-.(15) ;*CI2=R4+FI2
02100 FSBR 2,1 ;** 2=CI3=FI2-R4
02200 R4CR2C: MOVEM 4,.-.(15) ;* 4=CR2
02300 R4CR3C: MOVEM 5,.-.(15) ;* 5=CR3
02400 R4CI3C: MOVEM 2,.-.(15) ;* 2=CI3
02500 ADDI 15,4
02600 NTHPOB: CAIG 15,.-. ;INITED TO IMMED. CONST. NTHPO
02700 JRST R4TXL
02800 JRST P5
02900 R8TX: MOVE 0,X
03000 ADD 0,NXTLT
03100 HRRM 0,R8CR1A
03200 HRRM 0,R8CR1B
03300 ADD 0,NXTLT
03400 HRRM 0,R8CR2A
03500 HRRM 0,R8CR2B
03600 ADD 0,NXTLT
03700 HRRM 0,R8CR3A
03800 HRRM 0,R8CR3B
03900 ADD 0,NXTLT
04000 HRRM 0,R8CR4A
04100 HRRM 0,R8CR4B
04200 HRRM 0,R8CR4C
04300 ADD 0,NXTLT
04400 HRRM 0,R8CR5A
04500 HRRM 0,R8CR5B
04600 HRRM 0,R8CR5C
04700 ADD 0,NXTLT
04800 HRRM 0,R8CR6A
04900 HRRM 0,R8CR6B
05000 HRRM 0,R8CR6C
00100
00200 ADD 0,NXTLT
00300 HRRM 0,R8CR7A
00400 HRRM 0,R8CR7B
00500 HRRM 0,R8CR7C
00600 MOVE 0,Y
00700 ADD 0,NXTLT
00800 HRRM 0,R8CI1A
00900 HRRM 0,R8CI1B
01000 ADD 0,NXTLT
01100 HRRM 0,R8CI2A
01200 HRRM 0,R8CI2B
01300 ADD 0,NXTLT
01400 HRRM 0,R8CI3A
01500 HRRM 0,R8CI3B
01600 ADD 0,NXTLT
01700 HRRM 0,R8CI4A
01800 HRRM 0,R8CI4B
01900 HRRM 0,R8CI4C
02000 ADD 0,NXTLT
02100 HRRM 0,R8CI5A
02200 HRRM 0,R8CI5B
02300 HRRM 0,R8CI5C
02400 ADD 0,NXTLT
02500 HRRM 0,R8CI6A
02600 HRRM 0,R8CI6B
02700 HRRM 0,R8CI6C
02800 ADD 0,NXTLT
02900 HRRM 0,R8CI7A
03000 HRRM 0,R8CI7B
03100 HRRM 0,R8CI7C
03200 MOVE 4,TWOPI
03300 JSA 16,FLOAT ;ONLY CALL ON FLOAT
03400 ARG LENGT
03500 FDVR 4,0
03600 MOVEM 4,SCALE
00100
00200 ;ACCUMULATORS
00300 AC0=0
00400 AC1=1
00500 AC2=2
00600 AC3=3
00700 AC4=4
00800 AC5=5
00900 AC6=6
01000 AC7=7
01100 AC10=10
01200 AC11=11
01300 AC12=12
01400 AC13=13
01500 ACJ=14
01600 ACK=15
01700 ACR2=16
01800 ACMR2=17
01900 MOVEI ACJ,0 ;INIT J
02000 MOVE ACR2,COS45 ;SETUP ACR2
02100 MOVN ACMR2,ACR2 ;SETUP ACMR2
02200 MOVEI ACK,1(ACJ) ;SETUP K
02300 JRST LOOPK ;FAST START
02400 LOOPJ: MOVEM ACJ,J ;SAVE J
02500 FSC ACJ,233 ;FLOAT J
02600 FMPR ACJ,SCALE ;MAKE ANGLE
02700 MOVEM ACJ,ARGUM ;SAVE FOR SIN AND COS
02800 JSA 16,COS ;ONLY CALL ON COS
02900 ARG ARGUM
03000 MOVEM 0,C1
03100 JSA 16,SIN ;ONLY CALL ON SIN
03200 ARG ARGUM
03300 MOVEM 0,S1
03400 ;AC0=S1
03500 MOVE AC1,AC0 ; AC1=S1
03600 MOVE AC2,AC1 ; AC2=S1
03700 MOVE AC3,C1 ; AC3=C1
03800 MOVE AC4,AC3 ; AC4=C1
03900 MOVE AC5,AC4 ; AC5=C1
04000 MOVE AC6,AC5 ; AC6=C1
04100 FMPR AC3,AC0 ; AC3=S1*C1
04200 FADR AC3,AC3 ; AC3=S2=2*S1*C1
04300 MOVEM AC3,S2 ;STORE
04400 FMPR AC0,AC1 ; AC0=S1*S1
04500 FMPR AC4,AC5 ; AC4=C1*C1
04600 FSBRB AC4,AC0 ; AC0=AC4=C2=C1*C1-S1*S1
04700 MOVEM AC0,C2 ;STORE
04800 FMPR AC2,AC0 ; AC2=S1*C2
04900 FMPR AC6,AC3 ; AC6=C1*S2
05000 FADRB AC2,AC6 ; AC2=AC6=S3=S1*C2+C1*S2
05100 MOVEM AC2,S3 ;STORE
00100
00200 FMPR AC5,AC0 ; AC5=C1*C2
00300 FMPR AC1,AC3 ; AC1=S1*S2
00400 FSBRB AC5,AC1 ; AC5=AC1=C3=C1*C2-S1*S2
00500 MOVEM AC5,C3 ;STORE
00600 MOVE AC7,AC3 ; AC7=S2
00700 FMPR AC7,AC1 ; AC7=S2*C3
00800 FMPR AC2,AC0 ; AC2=S3*C2
00900 FADR AC7,AC2 ; AC7=S5=S2*C3+S3*C2
01000 MOVEM AC7,S5 ;STORE
01100 MOVE AC7,AC3 ; AC7=S2
01200 MOVE AC2,AC0 ; AC2=C2
01300 FMPR AC2,AC5 ; AC2=C2*C3
01400 FMPR AC7,AC6 ; AC7=S2*S3
01500 FSBR AC2,AC7 ; AC2=C5=C2*C3-S2*S3
01600 MOVEM AC2,C5 ;STORE
01700 FMPR AC4,AC3 ; AC4=C2*S2
01800 FADR AC4,AC4 ; AC4=S4=2*C2*S2
01900 MOVEM AC4,S4 ;STORE
02000 FMPR AC0,AC0 ; AC0=C2*C2
02100 FMPR AC3,AC3 ; AC3=S2*S2
02200 FSBRB AC0,AC3 ; AC0=AC3=C4=C2*C2-S2*S2
02300 MOVEM AC0,C4 ;STORE
02400 MOVE AC7,AC4 ; AC7=S4
02500 FMPR AC3,AC6 ; AC3=C4*S3
02600 FMPR AC7,AC5 ; AC7=S4*C3
02700 FADR AC3,AC7 ; AC3=S7=C4*S3+S4*C3
02800 MOVEM AC3,S7 ;STORE
02900 FMPR AC0,AC5 ; AC0=C4*C3
03000 FMPR AC4,AC6 ; AC4=S4*S3
03100 FSBR AC0,AC4 ; AC0=C7=C4*C3-S4*S3
03200 MOVEM AC0,C7 ;STORE
03300 FMPR AC1,AC6 ; AC1=C3*S3
03400 FADR AC1,AC1 ; AC1=S6=2*C3*S3
03500 MOVEM AC1,S6 ;STORE
03600 FMPR AC5,AC5 ; AC5=C3*C3
03700 FMPR AC6,AC6 ; AC6=S3*S3
03800 FSBR AC5,AC6 ; AC5=C6=C3*C3-S3*S3
03900 MOVEM AC5,C6 ;STORE
04000 MOVE ACJ,J ;RESET J
04100 MOVE ACR2,COS45 ;RESET ACR2
04200 MOVN ACMR2,ACR2 ;SETUP ACMR2
04300 MOVEI ACK,1(ACJ) ;SETUP K
00100
00200 LOOPK:
00300 ;INNER-MOST LOOP F0R RADIX 8 ITERATI0N
00400 R8CR0A: MOVE AC0,.-.(ACK) ;CR0+CR4
00500 R8CR4A: FADR AC0,.-.(ACK) ; AC0=AR0
00600 R8CR1A: MOVE AC1,.-.(ACK) ;CR1+CR5
00700 R8CR5A: FADR AC1,.-.(ACK) ; AC1=AR1
00800 R8CR2A: MOVE AC2,.-.(ACK) ;CR2+CR6
00900 R8CR6A: FADR AC2,.-.(ACK) ; AC2=AR2
01000 R8CR3A: MOVE AC3,.-.(ACK) ;CR3+CR7
01100 R8CR7A: FADR AC3,.-.(ACK) ; AC3=AR3
01200 R8CI0A: MOVE AC4,.-.(ACK) ;CI0+CI4
01300 R8CI4A: FADR AC4,.-.(ACK) ; AC4=AI0
01400 R8CI1A: MOVE AC5,.-.(ACK) ;CI1+CI5
01500 R8CI5A: FADR AC5,.-.(ACK) ; AC5=AI1
01600 R8CI2A: MOVE AC6,.-.(ACK) ;CI2+CI6
01700 R8CI6A: FADR AC6,.-.(ACK) ; AC6=AI2
01800 R8CI3A: MOVE AC7,.-.(ACK) ;CI3+CI7
01900 R8CI7A: FADR AC7,.-.(ACK) ; AC7=AI3
02000 MOVE AC10,AC0 ; AC10=AR0
02100 MOVE AC11,AC1 ; AC11=AR1
02200 MOVE AC12,AC4 ; AC12=AI0
02300 MOVE AC13,AC5 ; AC13=AI1
02400 FADR AC10,AC2 ; AC10=BR0=AR0+AR2
02500 FSBR AC11,AC3 ; AC11=BR3=AR1-AR3
02600 FADR AC12,AC6 ; AC12=BI0=AI0+AI2
02700 FSBR AC13,AC7 ; AC13=BI3=AI1-AI3
02800 FSBRB AC0,AC2 ; AC0=AC2=BR2=AR0-AR2
02900 FADRB AC1,AC3 ; AC1=AC3=BR1=AR1+AR3
03000 FSBRB AC4,AC6 ; AC4=AC6=BI2=AI0-AI2
03100 FADRB AC5,AC7 ; AC5=AC7=BI1=AI1+AI3
03200 FADR AC1,AC10 ;** AC1=CR0=BR1+BR0
03300 FADR AC5,AC12 ;** AC5=CI0=BI1+BI0
03400 JUMPE ACJ,R8J0A ;J=0 SPECIAL CASE
03500 FSBRB AC12,AC7 ; AC12=AC7=BI0-BI1
03600 FSBRB AC10,AC3 ; AC10=AC3=BR0-BR1
03700 FMPR AC10,C4 ; AC10=C4*(BR0-BR1)
03800 FMPR AC3,S4 ; AC3=S4*(BR0-BR1)
03900 FMPR AC12,C4 ; AC12=C4*(BI0-BI1)
04000 FMPR AC7,S4 ; AC7=S4*(BI0-BI1)
04100 FSBR AC10,AC7 ;** AC10=CR1
04200 FADR AC12,AC3 ;** AC12=CI1
04300 FSBR AC0,AC13 ; AC0=BR2-BI3
04400 MOVE AC7,AC0 ;=AC7
04500 FADRB AC2,AC13 ; AC2=AC13=BR2+BI3
04600 FSBR AC4,AC11 ; AC4=BI2-BR3
04700 MOVE AC3,AC4 ;=AC3
04800 FADRB AC6,AC11 ; AC6=AC11=BI2+BR3
04900 FMPR AC0,C2 ; AC0=C2*(BR2-BI3)
05000 FMPR AC6,S2 ; AC6=S2*(BI2+BR3)
05100 FMPR AC11,C2 ; AC11=C2*(BI2+BR3)
00100
00200 FMPR AC7,S2 ; AC7=S2*(BR2-BI3)
00300 FMPR AC13,C6 ; AC13=C6*(BR2+BI3)
00400 FMPR AC3,S6 ; AC3=S6*(BI2-BR3)
00500 FMPR AC4,C6 ; AC4=C6*(BI2-BR3)
00600 FMPR AC2,S6 ; AC2=S6*(BR2+BI3)
00700 FSBR AC0,AC6 ;** AC0=CR2
00800 FADR AC11,AC7 ;** AC11=CI2
00900 FSBR AC13,AC3 ;** AC13=CR3
01000 FADR AC4,AC2 ;** AC4=CI3
01100 R8JXA:
01200 R8CR0B: EXCH AC1,.-.(ACK) ;* AC1=CR0
01300 R8CR1B: EXCH AC10,.-.(ACK) ;* AC10=CR1
01400 R8CR2B: EXCH AC0,.-.(ACK) ;* AC0=CR2
01500 R8CR3B: EXCH AC13,.-.(ACK) ;* AC13=CR3
01600 R8CI0B: EXCH AC5,.-.(ACK) ;* AC5=CI0
01700 R8CI1B: EXCH AC12,.-.(ACK) ;* AC12=CI1
01800 R8CI2B: EXCH AC11,.-.(ACK) ;* AC11=CI2
01900 R8CI3B: EXCH AC4,.-.(ACK) ;* AC4=CI3
02000 R8CR4B: FSBR AC1,.-.(ACK) ; AC1=AR4
02100 R8CR5B: FSBR AC10,.-.(ACK) ; AC10=AR5
02200 R8CR6B: FSBR AC0,.-.(ACK) ; AC0=AR6
02300 R8CR7B: FSBR AC13,.-.(ACK) ; AC13=AR7
02400 R8CI4B: FSBR AC5,.-.(ACK) ; AC5=AI4
02500 R8CI5B: FSBR AC12,.-.(ACK) ; AC12=AI5
02600 R8CI6B: FSBR AC11,.-.(ACK) ; AC11=AI6
02700 R8CI7B: FSBR AC4,.-.(ACK) ; AC4=AI7
02800 MOVE AC2,AC1 ; AC2=AR4
02900 MOVE AC3,AC10 ; AC3=AR5
03000 MOVE AC6,AC5 ; AC6=AI4
03100 MOVE AC7,AC12 ; AC7=AI5
03200 FADR AC1,AC11 ; AC1=BR6=AR4+AI6
03300 FSBRB AC2,AC11 ; AC2=AC11=BR4=AR4-AI6
03400 FADR AC3,AC4 ; AC3=BR7=AR5+AI7
03500 FSBRB AC10,AC4 ; AC4=AC10=BR5=AR5-AI7
03600 FSBR AC6,AC0 ; AC6=BI6=AI4-AR6
03700 FADRB AC5,AC0 ; AC5=AC0=BI4=AI4+AR6
03800 FSBR AC7,AC13 ; AC7=BI7=AI5-AR7
03900 FADR AC12,AC13 ; AC12=BI5=AI5+AR7
04000 FSBR AC4,AC12 ; AC4=BR5-BI5
04100 FADR AC10,AC12 ; AC10=BR5+BI5
04200 FMPR AC4,ACR2 ; AC4=TR5
04300 FMPR AC10,ACR2 ; AC10=TI5
04400 MOVE AC12,AC3 ; AC12=BR7
04500 FADR AC12,AC7 ; AC12=BR7+BI7
04600 FSBR AC3,AC7 ; AC3=BR7-BI7
04700 FMPR AC12,ACMR2 ; AC12=TR7
04800 FMPR AC3,ACR2 ; AC3=TI7
04900 JUMPE ACJ,R8J0B ;J=0 SPECIAL CASE
05000 FADR AC2,AC4 ; AC2=BR4+TR5
05100 MOVE AC7,AC2 ;=AC7
05200 FSBRB AC11,AC4 ; AC11=AC4=BR4-TR5
00100
00200 FADR AC5,AC10 ; AC5=BI4+TI5
00300 MOVE AC13,AC5 ;=AC13
00400 FSBRB AC0,AC10 ; AC0=AC10=BI4-TI5
00500 FMPR AC2,C1 ; AC2=C1*(BR4+TR5)
00600 FMPR AC13,S1 ; AC13=S1*(BI4+TI5)
00700 FMPR AC5,C1 ; AC5=C1*(BI4+TI5)
00800 FMPR AC7,S1 ; AC7=S1*(BR4+TR5)
00900 FMPR AC11,C5 ; AC11=C5*(BR4-TR5)
01000 FMPR AC10,S5 ; AC10=S5*(BI4-TI5)
01100 FMPR AC0,C5 ; AC0=C5*(BI4-TI5)
01200 FMPR AC4,S5 ; AC4=S5*(BR4-TR5)
01300 FSBR AC2,AC13 ;** AC2=CR4
01400 FADR AC5,AC7 ;** AC5=CI4
01500 FSBR AC11,AC10 ;** AC11=CR5
01600 FADR AC0,AC4 ;** AC0=CI5
01700 MOVE AC4,AC1 ; AC4=BR6
01800 MOVE AC7,AC6 ; AC7=BI6
01900 FADR AC1,AC12 ; AC1=BR6+TR7
02000 MOVE AC13,AC1 ;=AC13
02100 FADR AC6,AC3 ; AC6=BI6+TI7
02200 MOVE AC10,AC6 ;=AC10
02300 FSBRB AC4,AC12 ; AC4=AC12=BR6-TR7
02400 FSBRB AC7,AC3 ; AC7=AC3=BI6-TI7
02500 FMPR AC1,C3 ; AC1=C3*(BR6+TR7)
02600 FMPR AC10,S3 ; AC10=S3*(BI6+TI7)
02700 FMPR AC6,C3 ; AC6=C3*(BI6+TI7)
02800 FMPR AC13,S3 ; AC13=S3*(BR6+TR7)
02900 FMPR AC4,C7 ; AC4=C7*(BR6-TR7)
03000 FMPR AC3,S7 ; AC3=S7*(BI6-TI7)
03100 FMPR AC7,C7 ; AC7=C7*(BI6-TI7)
03200 FMPR AC12,S7 ; AC12=S7*(BR6-TR7)
03300 FSBR AC1,AC10 ;** AC1=CR6
03400 FADR AC6,AC13 ;** AC6=CI6
03500 FSBR AC4,AC3 ;** AC4=CR7
03600 FADR AC7,AC12 ;** AC7=CI7
03700 R8JXB:
03800 R8CR4C: MOVEM AC2,.-.(ACK) ;* AC2=CR4
03900 R8CR5C: MOVEM AC11,.-.(ACK) ;* AC11=CR5
04000 R8CR6C: MOVEM AC1,.-.(ACK) ;* AC1=CR6
04100 R8CR7C: MOVEM AC4,.-.(ACK) ;* AC4=CR7
04200 R8CI4C: MOVEM AC5,.-.(ACK) ;* AC5=CI4
04300 R8CI5C: MOVEM AC0,.-.(ACK) ;* AC0=CI5
04400 R8CI6C: MOVEM AC6,.-.(ACK) ;* AC6=CI6
04500 R8CI7C: MOVEM AC7,.-.(ACK) ;* AC7=CI7
04600 LENGTA: ADDI ACK,.-. ;INITED TO IMMED. VAR. LENGT BY LOOP1
04700 NTHPOC: CAIG ACK,.-. ;INITED TO IMMED. CONST. NTHPO
04800 JRST LOOPK ;LOOP
04900 NXTLTA: CAIGE ACJ,.-. ;INITED TO IMMED. VAR. NXTLT-1 BY LOOP1
05000 AOJA ACJ,LOOPJ ;LOOP
05100 JRST CONT8 ;CONTINUE
00100
00200 ;J=0 SPECIAL CASE A
00300 R8J0A:
00400 FSBR AC10,AC3 ;** AC10=CR1=BR0-BR1
00500 FSBR AC12,AC7 ;** AC12=CI1=BI0-BI1
00600 FSBR AC0,AC13 ;** AC0=CR2=BR2-BI3
00700 FSBR AC4,AC11 ;** AC4=CI3=BI2-BR3
00800 FADR AC11,AC6 ;** AC11=CI2=BR3+BI2
00900 FADR AC13,AC2 ;** AC13=CR3=BI3+BR2
01000 JRST R8JXA ;CONTINUE
01100 ;J=0 SPECIAL CASE B
01200 R8J0B:
01300 FADR AC2,AC4 ;** AC2=CR4=BR4+TR5
01400 FADR AC5,AC10 ;** AC5=CI4=BI4+TI5
01500 FSBR AC11,AC4 ;** AC11=CR5=BR4-TR5
01600 FSBR AC0,AC10 ;** AC0=CI5=BI4-TI5
01700 MOVE AC4,AC1 ; AC4=BR6
01800 MOVE AC7,AC6 ; AC7=BI6
01900 FADR AC1,AC12 ;** AC1=CR6=BR6+TR7
02000 FADR AC6,AC3 ;** AC6=CI6=BI6+TI7
02100 FSBR AC4,AC12 ;** AC4=CR7=BR6-TR7
02200 FSBR AC7,AC3 ;** AC7=CI7=BI6-TI7
02300 JRST R8JXB ;CONTINUE
02400 P5:
02500 NTHPOD: MOVEI 1,.-. ;INITED TO IMMED. CONST. NTHPO
02600 SUBI 1,1
02700 MOVE 2,1
02800 MOVE 3,1
02900 SUBI 2,1
03000 LOOP: JFFO 3,.+1
03100 XOR 3,TABLE-25(4)
03200 AND 3,1
03300 CAMG 3,2
03400 JRST BD2
03500 LOP$1: MOVE 5,.-.(3) ;INITED TO IMMED. CONST. PTR TO X ARRAY
03600 LOP$2: MOVE 7,.-.(3) ;INITED TO IMMED. CONST. PTR TO Y ARRAY
03700 LOP$3: EXCH 5,.-.(2) ;INITED TO IMMED. CONST. PTR TO X ARRAY
03800 LOP$4: EXCH 7,.-.(2) ;INITED TO IMMED. CONST. PTR TO Y ARRAY
03900 LOP$5: MOVEM 5,.-.(3) ;INITED TO IMMED. CONST. PTR TO X ARRAY
04000 LOP$6: MOVEM 7,.-.(3) ;INITED TO IMMED. CONST. PTR TO Y ARRAY
04100 BD2: SOJG 2,LOOP
04200 FINISH: HRLZI 17,ACSAV
04300 BLT 17,17
04400 JRA 16,3(16)
00100
00200 TABLE: ↑B111111111111111111111100000000000000
00300 ↑B111111111111111111111110000000000000
00400 ↑B111111111111111111111111000000000000
00500 ↑B111111111111111111111111100000000000
00600 ↑B111111111111111111111111110000000000
00700 ↑B111111111111111111111111111000000000
00800 ↑B111111111111111111111111111100000000
00900 ↑B111111111111111111111111111110000000
01000 ↑B111111111111111111111111111111000000
01100 ↑B111111111111111111111111111111100000
01200 ↑B111111111111111111111111111111110000
01300 ↑B111111111111111111111111111111111000
01400 ↑B111111111111111111111111111111111100
01500 ↑B111111111111111111111111111111111110
01600 ↑B111111111111111111111111111111111111
01700
01800 ACSAV: BLOCK 20
01900 ARGUM: 0
02000 C1: 0
02100 C2: 0
02200 C3: 0
02300 C4: 0
02400 C5: 0
02500 C6: 0
02600 C7: 0
02700 COS45: 0.7071067812
02800 IPASS: 0
02900 J: 0
03000 LENGT: 0
03100 NEG.3: -3
03200 NXTLT: 0
03300 S1: 0
03400 S2: 0
03500 S3: 0
03600 S4: 0
03700 S5: 0
03800 S6: 0
03900 S7: 0
04000 SCALE: 0
04100 TWOPI: 6.283185307
04200 X: 0
04300 Y: 0
04400
04500
04600 XPUNGE
04700 END